BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Prog/D-G/Floating Windows.cpt/Floating Windows/FloatTest.p

Text File | 1991-11-13 | 5.1 KB | 304 lines | [TEXT/PJMM]

PROGRAM FloatTest;

USES
    Floating;

CONST
    TypeMask = $FF000000;
    SuspendResumeEvt = $1000000;
    SuspendResumeBit = 1;

    mApple = 128;
    iAbout = 1;
    mFile = 129;
    iQuit = 1;

VAR
    windowA, windowB, windowC: WindowPtr;
    floatWindow1, floatWindow2, floatWindow3: WindowPtr;
    running, WNEImplemented, inBackground: Boolean;


PROCEDURE Initialize;
    VAR
        theMBar: Handle;

    BEGIN
        MaxApplZone;    { ??? }
        MoreMasters;
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        InitDialogs(NIL);
        InitCursor;

        theMBar := GetNewMBar(128);
        SetMenuBar(theMBar);
        DrawMenuBar;

        WNEImplemented := (NGetTrapAddress($60, ToolTrap) <> NGetTrapAddress($9F, ToolTrap));
        inBackground := false;
        running := true;
        InitFloat;
    END;

PROCEDURE MakeWindows;
    BEGIN
        floatWindow1 := NewFloatingWindow(131, NIL);
        floatWindow2 := NewFloatingWindow(132, NIL);
        floatWindow3 := NewFloatingWindow(133, NIL);

        windowA := GetNewWindow(128, NIL, NIL);
        SelectTheWindow(windowA);

        windowB := GetNewWindow(129, NIL, NIL);
        SelectTheWindow(windowB);

        windowC := GetNewWindow(130, NIL, NIL);
        SelectTheWindow(windowC);

    END;


PROCEDURE doAbout;
    CONST
        kAboutAlrtID = 128;

    VAR
        itemHit: Integer;

    BEGIN
        itemHit := Alert(kAboutAlrtID, NIL);
    END;


PROCEDURE DoMenu (mResult: LongInt);
    VAR
        theMenu, theItem: Integer;
        mHandle: MenuHandle;

    BEGIN
        mHandle := GetMHandle(theMenu);

        theMenu := HiWord(mResult);
        theItem := LoWord(mResult);

        CASE theMenu OF
            mApple:
                CASE theItem OF
                    iAbout:
                        doAbout;
                END;

            mFile:
                CASE theItem OF
                    iQuit:
                        running := FALSE;

                    OTHERWISE
                        ;
                END;

            OTHERWISE
                ;
        END;

        HiliteMenu(0);
    END;


PROCEDURE GrowTheWindow (whichWindow: WindowPtr; where: Point);
    VAR
        newBounds: LongInt;
        growRect: Rect;
        savePort: GrafPtr;

    BEGIN
        GetPort(savePort);
        SetPort(whichWindow);
        SetRect(growRect, 200, 150, 500, 300);
        newBounds := GrowWindow(whichWindow, where, growRect);
        IF newBounds <> 0 THEN
        BEGIN
            EraseRect(whichWindow^.portRect);
            SizeWindow(whichWindow, LoWord(newBounds), HiWord(newBounds), true);
            InvalRect(whichWindow^.portRect);
        END;
        SetPort(savePort);
    END;


PROCEDURE ZoomTheWindow (whichWindow: WindowPtr; where: Point; inOrOut: Integer);
    VAR
        portRect: Rect;

    BEGIN
        IF TrackBox(whichWindow, where, inOrOut) THEN
        BEGIN
            portRect := whichWindow^.portRect;
            EraseRect(portRect);
            ZoomWindow(whichWindow, inOrOut, false);
            portRect := whichWindow^.portRect;
            InvalRect(portRect);
        END;
    END;


PROCEDURE DoActivate (whichWindow: WindowPtr);
    BEGIN
        SetPort(whichWindow);
        DrawGrowIcon(whichWindow);
    END;


PROCEDURE DoDeactivate (whichWindow: WindowPtr);
    BEGIN
        SetPort(whichWindow);
        DrawGrowIcon(whichWindow);
    END;


PROCEDURE DoUpdate (whichWindow: WindowPtr);
    VAR
        savePort: GrafPtr;

    BEGIN
        GetPort(savePort);
        SetPort(whichWindow);
        BeginUpdate(whichWindow);

        { do your drawing here... }

        DrawGrowIcon(whichWindow);
        EndUpdate(whichWindow);
        SetPort(savePort);
    END;


PROCEDURE DoResume (theEvent: EventRecord);
    BEGIN
        inBackground := FALSE;
        ShowFloats;
    END;


PROCEDURE DoSuspend (theEvent: EventRecord);
    BEGIN
        inBackground := TRUE;
        HideFloats;
    END;


PROCEDURE DoMouseDown (theEvent: EventRecord);
    VAR
        whichWindow: WindowPtr;
        thePart: Integer;

    BEGIN
        thePart := FindWindow(theEvent.where, whichWindow);
        CASE thePart OF
            inDesk:
                ;
            inMenuBar:
                DoMenu(MenuSelect(theEvent.where));
            inSysWindow:
                SystemClick(theEvent, whichWindow);
            inContent:
                SelectTheWindow(whichWindow);
            inDrag:
                DragTheWindow(whichWindow, theEvent);
            inGrow:
                GrowTheWindow(whichWindow, theEvent.where);

            inGoAway:
            BEGIN
                IF TrackGoAway(whichWindow, theEvent.where) THEN
                    CloseTheWindow(whichWindow);
                IF FrontWindow = NIL THEN
                    running := FALSE;
            END;

            inZoomIn, inZoomOut:
                ZoomTheWindow(whichWindow, theEvent.where, thePart);
        END;
    END;


PROCEDURE DoEvent (theEvent: EventRecord);
    VAR
        ch: Char;
        whichWindow: WindowPtr;

    BEGIN
        whichWindow := WindowPtr(theEvent.message);

        CASE theEvent.what OF
            nullEvent:
                ;
            mouseDown:
                DoMouseDown(theEvent);

            keyDown:
            BEGIN
                ch := CHR(BAnd(theEvent.message, charCodeMask));
                IF BAnd(theEvent.modifiers, cmdKey) = cmdKey THEN
                    DoMenu(MenuKey(ch));
            END;

            activateEvt:
                IF BAND(theEvent.modifiers, activeFlag) = activeFlag THEN
                    DoActivate(whichWindow)
                ELSE
                    DoDeactivate(whichWindow);

            updateEvt:
                DoUpdate(whichWindow);

            app4Evt:
            BEGIN
                CASE BAND(theEvent.message, TypeMask) OF
                    SuspendResumeEvt:
                        IF BAND(theEvent.message, SuspendResumeBit) = suspendResumeBit THEN
                            DoResume(theEvent)
                        ELSE
                            DoSuspend(theEvent);
                END;
            END;

            OTHERWISE
                ;
        END;

    END;


PROCEDURE EventLoop;
    VAR
        theEvent: EventRecord;

    BEGIN
        REPEAT
            IF WNEImplemented THEN
            BEGIN
                IF WaitNextEvent(everyEvent, theEvent, 0, NIL) THEN
                    DoEvent(theEvent);
            END
            ELSE
            BEGIN
                SystemTask;
                IF GetNextEvent(everyEvent, theEvent) THEN
                    DoEvent(theEvent);
            END;
        UNTIL NOT running;
    END;


BEGIN
    Initialize;
    MakeWindows;

    EventLoop;

    ExitToShell;
END.